home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / XLisp_1.6.cpt / StepLib.LSP < prev    next >
Lisp/Scheme  |  1985-04-27  |  3KB  |  91 lines
  1. ;+
  2. ;           STEPLIB: A library of useful functions needed by the STEP 1.0
  3. ;                       debugging tool.
  4. ;-
  5.  
  6. ;+
  7. ; autoload
  8. ;   Load a large function when it's called for the first time. After loading
  9. ;   the function then call it with whatever parameters were specified in the
  10. ;   first time call.
  11. ; 
  12. ; format
  13. ;   (autoload name file)
  14. ;       name - name of function to autoload.
  15. ;       file - filename of file which contains function.
  16. ;-
  17. (defmacro autoload (name file) 
  18.     `(defun ,name (&rest rest) (load (etoa ',file)) (apply ,name rest) ))
  19.  
  20. ;+
  21. ; case
  22. ;   Select an alternative based on the value of a selector. 
  23. ;
  24. ; format
  25. ;   (case <selector> [(<key>  [<action>]...)]... )
  26. ;       selector - an expression which will be evaluated to determine which
  27. ;                   action to perform.
  28. ;       key      - a quoted sexpr. If key matches the value of selector,
  29. ;                   the <action>s corresponding to this key are evaluated.
  30. ;       action   - an sexpr which will be evaluated if its key matches the
  31. ;                   value of the selector.
  32. ;       returns  - the value of the last action in the chosen list of actions.
  33. ;                  If no key matches the selector's value and if one of the 
  34. ;                  keys is 't', then the value of the last action in 't's 
  35. ;                  actions. If no catchall 't' is present then returns nil.
  36. ;-
  37. (defun case (selector &rest options)
  38.    (do* ((restl options (cdr restl)) (result nil))
  39.         ((let ((label (caar restl)))
  40.              (cond ((or (equal selector label)
  41.                         (eq t label) )
  42.                            (setq result (cdar restl)) )
  43.                    (t (null restl)) ) )
  44.         (eval (rplacd '(progn) result)) ) ) )
  45.  
  46.  
  47. ;+
  48. ; etoa
  49. ;   Convert expression to ascii string.
  50. ;
  51. ; format
  52. ;   (etoa <expr>)
  53. ;       <expr> - an expression whose value print string will be returned.
  54. ;-
  55. (defun etoa (symbol) (apply 'strcat (mapcar 'chr (explode symbol))))
  56.  
  57. ;+
  58. ; short-princ
  59. ;   Print an s-expression using princ, but don't print out the contents
  60. ;       of nested lists. Instead print (...).
  61. ;
  62. ; format
  63. ;   (short-princ <expr>)
  64. ;       <expr> an expression whose value will be short-printed.
  65. ;-
  66. (defun short-princ (sexpr)
  67.     (cond ((consp sexpr)
  68.              (princ "(")
  69.              (dolist (item sexpr)
  70.                      (if (consp item)
  71.                          (princ "(...)")
  72.                          (princ item) )
  73.                      (princ " ") )
  74.              (princ ")") )
  75.           (t (princ sexpr)) ) )
  76.  
  77. ;+
  78. ; spaces
  79. ;   Print out some spaces.
  80. ;
  81. ; format
  82. ;   (spaces <num> [<sink>])
  83. ;       <num> - number of spaces to print to the sink.
  84. ;       <sink>- the output sink (defaults to standard output)
  85. ;-
  86. (defun spaces (n &optional sink)
  87.     (cond ((null sink)(setq sink *standard-output*)))
  88.     (dotimes (count n t)
  89.                 (write-char 32 sink) ) )
  90.  
  91.